(ns algomain)

;Optimization algorithm -> travel optimization problem
(def travelers {"Mirko" "OB"
                "Igor" "BG"
                "Milos" "KR"
                "Pera" "VA"
                "Laza" "KG"
                "Stefan" "SU"
                "Nikola" "AR"})

(def destination "NS")

(defstruct busline :starting-point :destination :departure-time :arrival-time :cost)

(def buslines [(struct-map busline :starting-point "OB" :destination "NS" :departure-time "20:27" :arrival-time "22:27" :cost 300)
               (struct-map busline :starting-point "NS" :destination "OB" :departure-time "06:00" :arrival-time "07:30" :cost 355)
               (struct-map busline :starting-point "OB" :destination "NS" :departure-time "12:30" :arrival-time "14:10" :cost 340)
               (struct-map busline :starting-point "NS" :destination "OB" :departure-time "13:35" :arrival-time "14:55" :cost 320)
               (struct-map busline :starting-point "OB" :destination "NS" :departure-time "10:15" :arrival-time "13:05" :cost 250)
               (struct-map busline :starting-point "NS" :destination "OB" :departure-time "11:10" :arrival-time "13:30" :cost 220)
               (struct-map busline :starting-point "BG" :destination "NS" :departure-time "20:05" :arrival-time "22:35" :cost 235)
               (struct-map busline :starting-point "NS" :destination "BG" :departure-time "23:00" :arrival-time "00:30" :cost 283)
               (struct-map busline :starting-point "BG" :destination "NS" :departure-time "09:15" :arrival-time "11:20" :cost 290)
               (struct-map busline :starting-point "NS" :destination "BG" :departure-time "08:25" :arrival-time "10:05" :cost 324)
               (struct-map busline :starting-point "BG" :destination "NS" :departure-time "13:00" :arrival-time "14:30" :cost 338)
               (struct-map busline :starting-point "NS" :destination "BG" :departure-time "17:00" :arrival-time "18:15" :cost 385)
               (struct-map busline :starting-point "KR" :destination "NS" :departure-time "20:05" :arrival-time "23:50" :cost 340)
               (struct-map busline :starting-point "NS" :destination "KR" :departure-time "21:15" :arrival-time "00:30" :cost 365)
               (struct-map busline :starting-point "KR" :destination "NS" :departure-time "11:15" :arrival-time "15:00" :cost 325)
               (struct-map busline :starting-point "NS" :destination "KR" :departure-time "12:25" :arrival-time "17:00" :cost 290)
               (struct-map busline :starting-point "KR" :destination "NS" :departure-time "16:10" :arrival-time "19:30" :cost 340)
               (struct-map busline :starting-point "NS" :destination "KR" :departure-time "18:00" :arrival-time "21:30" :cost 350)
               (struct-map busline :starting-point "VA" :destination "NS" :departure-time "20:05" :arrival-time "22:30" :cost 360)
               (struct-map busline :starting-point "NS" :destination "VA" :departure-time "19:45" :arrival-time "22:10" :cost 370)
               (struct-map busline :starting-point "VA" :destination "NS" :departure-time "10:30" :arrival-time "13:30" :cost 310)
               (struct-map busline :starting-point "NS" :destination "VA" :departure-time "11:45" :arrival-time "14:20" :cost 362)
               (struct-map busline :starting-point "VA" :destination "NS" :departure-time "15:05" :arrival-time "17:55" :cost 285)
               (struct-map busline :starting-point "NS" :destination "VA" :departure-time "16:30" :arrival-time "20:10" :cost 275)
               (struct-map busline :starting-point "KG" :destination "NS" :departure-time "23:00" :arrival-time "02:00" :cost 334)
               (struct-map busline :starting-point "NS" :destination "KG" :departure-time "21:30" :arrival-time "00:50" :cost 345)
               (struct-map busline :starting-point "KG" :destination "NS" :departure-time "09:00" :arrival-time "12:10" :cost 382)
               (struct-map busline :starting-point "NS" :destination "KG" :departure-time "11:00" :arrival-time "14:20" :cost 375)
               (struct-map busline :starting-point "KG" :destination "NS" :departure-time "15:10" :arrival-time "18:30" :cost 338)
               (struct-map busline :starting-point "NS" :destination "KG" :departure-time "17:00" :arrival-time "20:30" :cost 350)
               (struct-map busline :starting-point "SU" :destination "NS" :departure-time "08:10" :arrival-time "09:15" :cost 220)
               (struct-map busline :starting-point "NS" :destination "SU" :departure-time "10:25" :arrival-time "11:30" :cost 225)
               (struct-map busline :starting-point "SU" :destination "NS" :departure-time "21:10" :arrival-time "22:30" :cost 200)
               (struct-map busline :starting-point "NS" :destination "SU" :departure-time "19:00" :arrival-time "20:30" :cost 195)
               (struct-map busline :starting-point "SU" :destination "NS" :departure-time "14:15" :arrival-time "15:20" :cost 230)
               (struct-map busline :starting-point "NS" :destination "SU" :departure-time "16:40" :arrival-time "18:00" :cost 215)
               (struct-map busline :starting-point "AR" :destination "NS" :departure-time "19:30" :arrival-time "21:30" :cost 345)
               (struct-map busline :starting-point "NS" :destination "AR" :departure-time "20:00" :arrival-time "22:05" :cost 350)
               (struct-map busline :starting-point "AR" :destination "NS" :departure-time "07:30" :arrival-time "10:10" :cost 310)
               (struct-map busline :starting-point "NS" :destination "AR" :departure-time "09:45" :arrival-time "12:15" :cost 305)
               (struct-map busline :starting-point "AR" :destination "NS" :departure-time "13:40" :arrival-time "16:00" :cost 325)
               (struct-map busline :starting-point "NS" :destination "AR" :departure-time "16:20" :arrival-time "18:40" :cost 320)])

(defn searchlines 
  "returns sublist of bus lines for a given criteria" 
  [coll dep dest]
  (filter 
    (fn [s] 
      (and (= dest (:destination s)) 
           (= dep (:starting-point s)))) 
    coll))

(defn domain 
  "defines the domain for the travel optimization problem" 
  [trcoll blines dest]
  (reduce (fn [res trvlrorigins]
            (let [alloutbound (- (count (searchlines blines trvlrorigins dest)) 1) 
                  allreturn (- (count (searchlines blines dest trvlrorigins)) 1)]
              (conj res (conj [] 0 alloutbound) (conj [] 0 allreturn))))
          [] (vals trcoll)))

;(domain travelers buslines destination)

(defn getminutes 
  "converts time into minutes" 
  [hrs]
  (let [h (. Integer valueOf (subs hrs 0 2)) 
        m (. Integer valueOf (subs hrs 3))] 
    (+ (* h 60) m)))

(defn nth-map
  "returns the nth element of a map"
  [coll elem-index]
  (let [coll-keys (keys coll)]
    (get coll (nth coll-keys elem-index))))

(defn totalwait 
  "calculates the total waiting costs" 
  [ltsarrival erldep sol trvls buses dstn]
  (let [outboundindexes (take-nth 2 sol)
        returnindexes (take-nth 2 (next sol))
        travelset (map vector outboundindexes returnindexes (vals trvls))]
           (reduce (fn [ttlwait trvlsets]
                (let [trvlorigin (second (next trvlsets))
                      alloutbound (searchlines buses trvlorigin dstn) 
                      allreturn (searchlines buses dstn trvlorigin)
                      outbound (nth alloutbound (first trvlsets))
                      return (nth allreturn (second trvlsets))]
                  (+ ttlwait (- ltsarrival (getminutes (:arrival-time outbound))) 
                     (- (getminutes (:departure-time return)) erldep))))
              0 travelset)))

(defmulti costcheckoutbound (fn [outb ltsarr]
                      (if (< ltsarr (getminutes (:arrival-time outb))) 
                        :out1
                        :out2)))

(defmethod costcheckoutbound :out1 [outb ltsarr]
  (getminutes (:arrival-time outb)))

(defmethod costcheckoutbound :out2 [outb ltsarr]
  ltsarr)

(defmulti costcheckreturn (fn [ret edep]
                            (if (> edep (getminutes (:departure-time ret))) 
                              :ret1
                        :ret2)))

(defmethod costcheckreturn :ret1 [ret edep]
  (getminutes (:departure-time ret)))

(defmethod costcheckreturn :ret2 [ret edep]
  edep)

(defn cost 
  "calculates travel cost" 
  [solution trvls buses dstn] 
  (let [totalprice 0 
        latestarrival 0 
        earliestdep (* 24 60)]
    (loop [cnt 0 
           ttlprice totalprice 
           ltsarrival latestarrival 
           erldep earliestdep 
           cnt1 0]
     (if (= cnt (/ (count solution) 2)) 
       (if (< erldep ltsarrival) 
         (+ ttlprice 50 (* 0.5 (totalwait ltsarrival erldep solution trvls buses dstn))) 
         (+ ttlprice (* 0.5 (totalwait ltsarrival erldep solution trvls buses dstn))))
       (let [alloutbound (searchlines buses (nth-map trvls cnt) dstn) 
             allreturn (searchlines buses dstn (nth-map trvls cnt))
             outbound (nth alloutbound (nth solution cnt1)) 
             return (nth allreturn (nth solution (+ 1 cnt1)))
             mins1 (costcheckoutbound outbound ltsarrival)
             mins2 (costcheckreturn return erldep)]
           (recur (inc cnt) (+ ttlprice (:cost outbound) (:cost return)) mins1 mins2 (+ cnt1 2)))))))

;failed attempt to reimplement the cost function while avoiding loop/recur and nth and using reduce
;(def latestarrival 0)
;(def earliestdep (* 24 60))

;(defn cost1 
;  "calculates travel cost" 
;  [solution trvls buses dstn ltarr erldp] 
;  (let [totalprice 0 
;        latestarrival ltarr 
;        earliestdep erldp
;        outboundindexes (take-nth 2 solution)
;        returnindexes (take-nth 2 (next solution))
;        travelset (map vector outboundindexes returnindexes (vals trvls))
;        result (reduce (fn [res sol]
;                         (let [trvlorigin (second (next travelset))
;                               alloutbound (searchlines buses trvlorigin dstn) 
;                               allreturn (searchlines buses dstn trvlorigin)
;                               outbound (nth alloutbound (first travelset))
;                               return (nth allreturn (second travelset))]
;                           (if (< latestarrival (getminutes (:arrival-time outbound))) 
;                             (binding [latestarrival (getminutes (:arrival-time outbound))]
;                           (if (> earliestdep (getminutes (:departure-time return))) 
;                             (binding [earliestdep (getminutes (:departure-time return))]
;                           (vector (+ res (:cost outbound) (:cost return)) latestarrival earliestdep))))))) totalprice travelset)]
;  (if (< (second result) (last result)) 
;    (+ (first result) 50 (* 0.5 (totalwait (last result) (second result) solution trvls buses dstn))) 
;    (+ (first result) (* 0.5 (totalwait (last result) (second result) solution trvls buses dstn))))))

;simulated annealing

(defn vec-replace 
  "replaces an element from a vector" 
  [coll indx updated-el]
  (let [counter 0 
        svec-after (subvec coll (+ indx 1))]
    (reduce (fn [result svec]
        (conj result svec)) 
            (conj (subvec coll 0  indx) updated-el) svec-after)))

(defmulti testmulti (fn [sol domn i] 
                      (cond
                        (< (nth sol i) (first (nth domn i))) :cond1
                        (> (nth sol i) (second (nth domn i))) :cond2)))

(defmethod testmulti :cond1 [sol domn i] 
  (vec-replace sol i (first (nth domn i))))

(defmethod testmulti :cond2 [sol domn i] 
  (vec-replace sol i (second (nth domn i))))

(defmethod testmulti :default [sol domn i] sol)

(defn change-element
  "mutates the solution by increasing or decreasing one element by the entered amount" 
  [solution step dom] 
  (let [i (quot (rand (count dom)) 1)  
        dir-range (range (- 0 step) (+ step 1))
        dir (nth dir-range (quot (rand (count dir-range)) 1))
        solutionb (vec-replace solution i (+ dir (nth solution i)))]
      (testmulti solutionb dom i)))

(defn randomstart
  "generates a random starting solution for a given domain" 
  [dom]
  (reduce (fn [res domn]
            (conj res (quot (rand (+ (second domn) 1)) 1))) 
          [] dom))

(defn pow 
  "calculates the power value of x for y" 
  [x y]
  (reduce * (repeat y x)))

(defn annealingoptimize 
  "performs the simulated annealing algorithm" 
  [dom costf temp cool step trvls buses dstn]
    (loop [result (randomstart dom) 
           t temp]
      (if (<= t 0.1) 
        result
        (let [ca (costf result trvls buses dstn) 
              cb (costf (change-element result step dom) trvls buses dstn)
              p (pow (. Math E) (/ (- (- 0 cb) ca) t))
              res (cond 
                    (or (< cb ca) (< (rand) p)) (change-element result step dom)
                    :else result)]
            (recur res (* t cool))))))

;(annealingoptimize (domain travelers buslines) cost 10000 0.95 1)

(defn printschedule 
  "prints the solution of the algorithm" 
  [solution trvls buses dstn]
  (let [outboundindexes (take-nth 2 solution)
        returnindexes (take-nth 2 (next solution))
        travelset (map vector outboundindexes returnindexes trvls)]
           (reduce (fn [res trvlsets]
                (let [trvlorigin (second (last trvlsets))
                      alloutbound (searchlines buses trvlorigin dstn) 
                      allreturn (searchlines buses dstn trvlorigin)
                      outbound (nth alloutbound (first trvlsets))
                      return (nth allreturn (second trvlsets))]
                  (conj res [(first (last trvlsets)) trvlorigin outbound return])))
              [] travelset)))

;the program is started by calling the printschedule function in the following manner:
(printschedule (annealingoptimize (domain travelers buslines destination) cost 10000 0.95 1 travelers buslines destination) travelers buslines destination)